home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / dejagnu / runtest.exp < prev    next >
Text File  |  1993-05-26  |  19KB  |  632 lines
  1. # Test Framework Driver
  2. #   Copyright (C) 1988, 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
  3.  
  4. # This program is free software; you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation; either version 2 of the License, or
  7. # (at your option) any later version.
  8. # 
  9. # This program is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. # GNU General Public License for more details.
  13. # 
  14. # You should have received a copy of the GNU General Public License
  15. # along with this program; if not, write to the Free Software
  16. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  17.  
  18. # Please email any bugs, comments, and/or additions to this file to:
  19. # bug-dejagnu@prep.ai.mit.edu
  20.  
  21. # This file was written by Rob Savoye. (rob@cygnus.com)
  22.     
  23. set frame_version    1.0.1
  24.  
  25. #
  26. # trap some signals so we know whats happening. These definitions are only
  27. # temporary until we read in the library stuff
  28. #
  29. trap { send_user "\nterminated\n";             exit 1 } SIGTERM
  30. trap { send_user "\ninterrupted by user\n";    exit 1 } SIGINT
  31. trap { send_user "\nsegmentation violation\n"; exit 1 } SIGSEGV
  32. trap { send_user "\nsigquit\n";                exit 1 } SIGQUIT
  33.  
  34. #
  35. # initialize a few global variables used by all tests
  36. #
  37. set do_a_diff    0        ;# flag enabling diff of summary logs
  38. set mail_logs   0        ;# flag for mailing of summary and diff logs
  39. set psum_file   "latest"    ;# file name of previous summary to diff against
  40. set passcnt    0        ;# number of testcases that passed
  41. set failcnt    0        ;# number of testcases that failed
  42. set xfailcnt    0        ;# number of testcases expected to fail which did
  43. set xpasscnt    0        ;# number of testcases that passed unexpectedly
  44. set exit_status    0        ;# exit code returned by this program
  45. set xfail_flag  0
  46. set xfail_prms    0
  47. set sum_file    ""        ;# name of the file that contains the summary log
  48. set base_dir    ""        ;# the current working directory
  49. set logname     ""        ;# the users login name
  50. set prms_id    0
  51. set bug_id    0
  52. set test_name    ""        ;# name of the test driver to be run
  53. set dir        ""        ;# temp variable for directory names
  54. set srcdir      "."        ;# source directory containing the test suite
  55. set ignoretests ""        ;# list of tests to not execute
  56. set target      ""        ;# type of architecture to run tests on
  57. set host        ""        ;# type of architecture to run tests from
  58. set objdir    "."        ;# directory where test case binaries live
  59. set target_triplet "native"    ;# canonical triplet target name
  60. set makevars    ""
  61.  
  62. #
  63. # some convenience abbreviations
  64. #
  65. if ![info exists hex] then {
  66.     set hex "0x\[0-9A-Fa-f\]+"
  67. }
  68. if ![info exists decimal] then {
  69.     set decimal "\[0-9\]+"
  70. }
  71.  
  72. #
  73. # set the base dir (current working directory)
  74. #
  75. if [string match "" $base_dir] then {
  76.     set base_dir [exec pwd]
  77.     if [string match "*Command not found*" $base_dir] then {
  78.     if [info exists env(PWD)] then {
  79.         set base_dir $env(PWD)
  80.     } else {
  81.         set base_dir ""
  82.     }
  83.     if [string match "" $base_dir] then {
  84.         puts stderr "ERROR: couldn't get the current directory" ; exit -1
  85.         }
  86.     }
  87. }
  88.  
  89. #
  90. # These are tested in case they are not initialized in site.exp. They are
  91. # tested here instead of the init module so they can be overridden by command
  92. # line options.
  93. #
  94. if ![info exists all_flag] then {
  95.     set all_flag    0
  96. }
  97. if ![info exists binpath] then {
  98.     set binpath    ""
  99. }
  100. if ![info exists debug] then {
  101.     set debug  0
  102. }
  103. if ![info exists options] then {
  104.     set options    ""
  105. }
  106. if ![info exists outdir] then {
  107.     set outdir      "."
  108. }
  109. if ![info exists reboot] then {
  110.     set reboot    1
  111. }
  112. if ![info exists runtests] then {
  113.     set runtests    ""
  114. }
  115. if ![info exists tracelevel] then {
  116.     set tracelevel  0
  117. }
  118. if ![info exists verbose] then {
  119.     set verbose    0
  120. }
  121.  
  122. #
  123. # get the users login name
  124. #
  125. if [string match "" $logname] then {
  126.     set logname [exec whoami]
  127.     if [string match "*Command not found*" $logname] then {
  128.     set logname [exec who am i]
  129.     if [string match "*Command not found*" $logname] then {    
  130.         send_user "ERROR: couldn't get the users login name\n" ; exit -1
  131.     } else {
  132.         set logname [lindex [split $logname " !"] 1]
  133.     }
  134.     }
  135. }
  136.  
  137. #
  138. # parse configuration args so the config file can get loaded. Otherwise 
  139. # command line options can't override the settings.
  140. #
  141. set match 0
  142. set argc [ llength $argv ]
  143. for { set i 1 } { $i < $argc } { incr i } {
  144.     global target_triplet
  145.     global host_triplet
  146.     set sub_arg [ lindex $argv $i ]
  147.     case $sub_arg in {
  148.  
  149.     {"[-+]ho*" "[-+][-+]ho*"} {            # (--host) the host configuration
  150.         incr i
  151.         set host_triplet [lindex $argv $i]
  152.         continue
  153.     }
  154.  
  155.     {"[-+]ta*" "[-+][-+]ta*"} {            # (--target) the target configuration
  156.         incr i
  157.         set target_triplet [lindex $argv $i]
  158.           # override local site file and load the configuration of a different target
  159.     }
  160.     }
  161. }
  162.  
  163. #
  164. # find where the config file is. ALL are sourced in order. The order is
  165. # first see if one is installed. Then look for for a parallel "dejagnu" 
  166. # directory up one or two directories. Finally source one in the current
  167. # dir if it exists.
  168. #
  169. set execpath     "[file dirname [lindex $argv 0]]"
  170. set libdir        [file dirname $execpath]/dejagnu
  171.  
  172. if [string match "." $objdir] then {
  173.     set objdir $base_dir
  174. }
  175.  
  176. foreach dir "$libdir/$target_triplet [file dirname $objdir]/dejagnu [file dirname [file dirname $objdir]]/dejagnu ." {
  177.     #send_user "Looking for config file $dir/site.exp\n"
  178.     if [file exists $dir/site.exp] then {
  179.     #send_user "Sourcing config file $dir/site.exp\n"
  180.     catch "source $dir/site.exp" tmp
  181.     }
  182. }
  183.  
  184. #
  185. # parse the command line arguments
  186. #
  187. set match 0
  188. set argc [ llength $argv ]
  189. for { set i 1 } { $i < $argc } { incr i } {
  190.     set sub_arg [ lindex $argv $i ]
  191.     case $sub_arg in {
  192.  
  193.     {"[-+]ho*" "[-+][-+]ho*"} {            # (--host) the host configuration
  194.         incr i
  195.         if $verbose>1 then { send_user "The host is now $host_triplet\n" }
  196.         continue
  197.     }
  198.  
  199.     {"[-+]ta*" "[-+][-+]ta*"} {            # (--target) the target configuration
  200.         incr i
  201.         if $verbose>1 then { send_user "The target is now $target_triplet\n" }
  202.         continue
  203.     }
  204.  
  205.     {"[-+]a*" "[-+][-+]a*"} {            # (--all) print all test output to screen
  206.         set all_flag 1
  207.         if $verbose>1 then { send_user "Print all test output to screen\n" }
  208.         continue
  209.     }
  210.  
  211.         {"[-+]b*" "[-+][-+]b*"} {            # (--baud) the baud to use for a serial line
  212.         incr i
  213.         set baud [lindex $argv $i]
  214.         if $verbose>1 then { send_user "The baud rate is now $baud\n" }
  215.         continue
  216.     }
  217.  
  218.     {"[-+]co*" "[-+][-+]co*"} {            # (--connect) the connection mode to use
  219.         incr i
  220.         set connectmode [lindex $argv $i]
  221.         if $verbose>1 then { send_user "Comm method is $connectmode\n" }
  222.         continue
  223.     }
  224.  
  225.     {"[-+]de*" "[-+][-+]de*"} {            # (--debug) expect internal debugging
  226.         catch "exec rm ./dbg.log"
  227.         debug -f dbg.log 0
  228.         if $verbose>1 then { send_user "Expect Debugging is ON \n" }
  229.         continue
  230.     }
  231.  
  232.     {"[-+]di*" "[-+][-+]di*"} {        # (--diff) diff the summary files
  233.         send_user "Sorry, --diff unimplemented\n"
  234.         #set do_a_diff 1
  235.         #incr i
  236.         #set psum_file [lindex $argv $i]
  237.         #if $verbose>1 then { send_user "Diff summary files when done\n" }
  238.         continue
  239.     }
  240.  
  241.     {"[-+]m*" "[-+][-+]m*"} {            # (--mail) mail the output
  242.         incr i
  243.         set mailing_list [lindex $argv $i]
  244.             set mail_logs 1
  245.         if $verbose>1 then { send_user "Mail results to $mailing_list\n" }
  246.         continue
  247.     }
  248.  
  249.     {"[-+]no*" "[-+][-+]no*"} {            # (--noreboot) Don't reboot the target
  250.         set reboot 0
  251.         if $verbose>1 then { send_user "Won't reboot the target\n" }
  252.         continue
  253.     }
  254.  
  255.     {"[-+]ob*" "[-+][-+]ob*"} {            # (--objdir) where the test case object code lives
  256.         incr i
  257.         set objdir [lindex $argv $i]
  258.         if $verbose>1 then { send_user "Using test binaries in $objdir\n" }
  259.         continue
  260.     }
  261.  
  262.     {"[-+]ou*" "[-+][-+]ou*"} {            # (--outdir) where to put the output files
  263.         incr i
  264.         set outdir [lindex $argv $i]
  265.         if $verbose>1 then { send_user "Test output put in $outdir\n" }
  266.         continue
  267.     }
  268.  
  269.     {"[-+]ru*" "[-+][-+]ru*"} {            #  (--runtest) specify test names to run
  270.         incr i
  271.         set runtests [lindex $argv $i]
  272.         if $verbose>1 then { send_user "Running only tests $runtests\n" }
  273.         continue
  274.     }
  275.  
  276.     {"[-+]i*" "[-+][-+]i*"} {            #  (--ignore) specify test names to exclude
  277.         incr i
  278.         set ignoretests [lindex $argv $i]
  279.         if $verbose>1 then { send_user "Ignoring test $ignoretests\n" }
  280.         continue
  281.     }
  282.  
  283.     {"[-+]sr*" "[-+][-+]sr*"} {            # (--srcdir) where the testsuite source code lives
  284.         incr i
  285.         set srcdir [lindex $argv $i]
  286.         if $verbose>1 then { send_user "Using test sources in $srcdir\n" }
  287.         continue
  288.     }
  289.  
  290.     {"[-+]st*" "[-+][-+]st*"} {            # (--strace) expect trace level
  291.         incr i
  292.         set tracelevel [ lindex $argv $i ]
  293.         strace $tracelevel
  294.         if $verbose>1 then { send_user "Source Trace level is now $tracelevel\n" }
  295.         continue
  296.     }
  297.  
  298.     {"[-+]n*" "[-+][-+]n*"} {            # (--name) the target's name
  299.         incr i
  300.         set targetname [lindex $argv $i]
  301.         if $verbose>1 then { send_user "Testing target $targetname\n" }
  302.         continue
  303.     }
  304.  
  305.     {"[-+]to*" "[-+][-+]to*"} {            # (--tool) specify tool name
  306.         incr i
  307.         set tool [lindex $argv $i]
  308.         if $verbose>1 then { send_user "Testing $tool\n" }
  309.         continue
  310.         }
  311.  
  312.     {"*[-+]V*" "*[-+]vers*"} {            # (--version) version numbers
  313.         send_user "Expect version is\t$expect_version\n"
  314.         send_user "Tcl version is\t\t[ info tclversion ]\n"
  315.         send_user "Framework version is\t$frame_version\n"
  316.         continue
  317.     }
  318.  
  319.     "[A-Z]*=*" {                    # process makefile style args like CC=gcc, etc...
  320.         set tmp [split $sub_arg "="]
  321.         set [lindex $tmp 0] [lindex $tmp 1]
  322.         if $verbose>1 then {
  323.                send_user "[lindex $tmp 0] is now [lindex $tmp 1]\n"
  324.             }
  325.         append makevars "set [lindex $tmp 0] [lindex $tmp 1];"
  326.         unset tmp
  327.         continue
  328.     }
  329.  
  330.     {"[-+]v*" "[-+][-+]v*" "*[-+]verb*"} {        # (--verbose) verbose output
  331.         incr verbose
  332.         if $verbose then { send_user "Verbose is now at level $verbose\n" }
  333.         continue
  334.     }
  335.  
  336.     {"[-+]he*" "[-+][-+]he*"} {        # (--help) help text
  337.         send_user "USAGE: runtest \[options...\]\n"
  338.         send_user "\t--all (-a)\t\tPrint all test output to screen\n"
  339.         send_user "\t--baud (-b)\t\tThe baud rate\n"
  340.         send_user "\t--connect (-co)\t\[type\]\tThe type of connection to use\n"
  341.         send_user "\t--debug (-de)\t\tSet expect debugging ON\n"
  342.         send_user "\t--diff \[name\]\t\tRun diff between two test runs\n"
  343.         send_user "\t--help (-he)\t\tPrint help text\n"
  344.         send_user "\t--mail \[name(s)\]\tWho to mail the results to\n"
  345.         send_user "\t--noreboot \[name\]\tDon't reboot the target\n"
  346.             send_user "\t--objdir \[name\]\t\tThe test suite binary directory\n"
  347.         send_user "\t--outdir \[name\]\t\tThe directory to put logs in\n"
  348.         send_user "\t--runtest \[name(s)\]\tThe names of specific tests to run\n"
  349.         send_user "\t--ignore \[name(s)\]\tThe names of specific tests to ignore\n"
  350.         send_user "\t--srcdir \[name\]\t\tThe test suite source code directory\n"
  351.         send_user "\t--strace \[number\]\tSet expect tracing ON\n"
  352.         send_user "\t--name \[name\]\t\tThe hostname of the target board\n"
  353.         send_user "\t--target \[string\]\tThe canonical config name of the target board\n"
  354.         send_user "\t--host \[string\]\t\tThe canonical config name of the host machine\n"
  355.         send_user "\t--tool\[name(s)\]\t\tRun tests on these tools\n"
  356.         send_user "\t--verbose (-v)\t\tEmit verbose output\n"
  357.         send_user "\t--version (-V)\t\tEmit all version numbers\n"
  358.         send_user "\tMakefile style arguments can also be used, ex. CC=gcc\n\n"
  359.         exit 0    
  360.     }
  361.  
  362.     default {        # default
  363.         send_user "\nIllegal Argument \"$sub_arg\"\n"
  364.         send_user "try \"runtest --help\" for option list\n"
  365.         exit 0
  366.     }
  367.  
  368.     }
  369. }
  370.  
  371. #
  372. # check for a few crucial variables
  373. #
  374. if ![info exists tool] then {
  375.     send_error "ERROR: No tool specified, use the --tool option\n"
  376.     exit 1
  377. }
  378.  
  379. if ![info exists host_triplet] then {
  380.     send_error "ERROR: No host configuration. Check the config file.\n"
  381.     exit 1
  382. }
  383.  
  384. if ![info exists target_triplet] then {
  385.     send_error "ERROR: No target configuration. Check the config file.\n"
  386.     exit 1
  387. }
  388.  
  389. #
  390. # initialize a few Tcl variables to something other than their default
  391. #
  392. if $verbose>2 then {
  393.     log_user 1
  394. } else {
  395.  
  396.     log_user 0
  397. }
  398. set timeout     10
  399.  
  400. #
  401. # load_lib --     loads a library by sourcing it. If there a multiple files with
  402. #                 the same name, they all get sourced in order. The order is first
  403. #           look in the install dir, then in a parallel dir in the source tree,
  404. #        (up one or two levels), then in the current dir.
  405. #
  406. proc load_lib { file } {
  407.     global verbose
  408.     global libdir
  409.     global srcdir
  410.     global base_dir
  411.     global execpath
  412.     global tool
  413.  
  414.     set found 0
  415.     set tmp   ""
  416.     foreach dir "$libdir $libdir/lib [file dirname [file dirname $srcdir]]/dejagnu/lib $srcdir/lib ." {
  417.     if $verbose>2 then {
  418.         send_user "Looking for $dir/$file\n"
  419.     }
  420.     if [file exists $dir/$file] then {
  421.         if $verbose>2 then {
  422.         send_user "Loading $dir/$file\n"
  423.         }
  424.         catch "source $dir/$file" tmp
  425.         if ![string match "" $tmp] then {
  426.         send_user "ERROR: errors in library file $dir/$file\n$tmp\n"
  427.         exit 1
  428.         } else {
  429.         set found 1
  430.         }
  431.     }
  432.     }
  433.     if $found==0 then {
  434.     send_user "ERROR: Couldn't load $file.\n"
  435.     exit 1
  436.     }
  437.     unset found
  438.     unset tmp
  439. }
  440.  
  441. #
  442. # load the testing framework libraries
  443. #
  444. load_lib utils.exp
  445. load_lib framework.exp
  446.  
  447. #
  448. #
  449. # set target variables only if needed.
  450. #
  451. if ![isnative] then {
  452.     # MVME board running *Bug boot monitor
  453.     if [istarget "*-abug-*"] then {
  454.     if ![info exists targetname] then {
  455.         puts stderr "ERROR: Need a target name for the target board."
  456.         puts stderr "       Use the --target option\n"
  457.         exit 1
  458.     }
  459.     # the default connect program to use
  460.     if ![info exists connectmode] then {
  461.         set connectmode    "tip"
  462.         warning "Using default of $connectmode for target communication."
  463.         }
  464.     }
  465.     # any flavor of vxworks
  466.     if [istarget "*-*-vxworks"] then {
  467.     # the hostname of the target board
  468.     if ![info exists targetname] then {
  469.     puts stderr "ERROR: Need a target name for the vxworks board."
  470.     puts stderr "       Use the --target option\n"
  471.     exit 1
  472.     }
  473.     # the default connect program to use
  474.     if ![info exists connectmode] then {
  475.         set connectmode    "rlogin"
  476.         warning "Using default of $connectmode for target communication."
  477.         }        
  478.     }
  479. }
  480.  
  481. #
  482. # open log files
  483. #
  484. open_logs
  485. clone_output "Test Run By $logname on [exec date]"
  486. clone_output "Target is $target_triplet"
  487. clone_output "Host   is $host_triplet"
  488. clone_output "\n\t\t=== $tool tests ===\n"
  489.  
  490. #
  491. # go find the init file. A local copy is sourced if it is found,
  492. # otherwise the system default one is sourced instead
  493. #
  494. set tool_init $srcdir/config/${target_abbrev}
  495.  
  496. #
  497. # find the tool init file. This is in the config directory of the tool's
  498. # testsuite directory. These used to all be named $target_os-$tool.exp,
  499. # but as the $tool variable goes away, it's now just $target_os.exp.
  500. #
  501. if [ expr "[file exists ${tool_init}-${tool}.exp] + [file exists ${tool_init}-${tool}.exp] == 2"] then {
  502.     catch "source ${tool_init}-${tool}.exp" error
  503.     if ![string match "" $error] then {
  504.     send_user "ERROR: errors in tool init file ${tool_init}-${tool}.exp\n$error\n"
  505.     exit 1
  506.     }
  507.     verbose "Sourced ${tool_init}-${tool}.exp" 2
  508. } else {
  509.     if [file exists ${tool_init}.exp] then {
  510.     catch "source ${tool_init}.exp" error
  511.     if ![string match "" $error] then {
  512.         send_user "ERROR: errors in tool init file ${tool_init}.exp\n$error\n"
  513.         exit 1
  514.     }
  515.     verbose "Sourced ${tool_init}.exp" 2
  516.     } else {
  517.     catch "source ${tool_init}-${tool}.exp" error
  518.     if ![string match "" $error] then {
  519.         send_user "ERROR: errors in tool init file ${tool_init}-${tool}.exp\n$error\n"
  520.         exit 1
  521.     }
  522.     verbose "Sourced ${tool_init}-${tool}.exp" 2
  523.     } else {
  524.     error "There is no tool init file in $srcdir/config"
  525.     exit 1
  526.     }
  527. }    
  528.  
  529. #
  530. # trap some signals so we know whats happening. These replace the the previous
  531. # ones cause we've now loaded the library stuff
  532. #
  533. trap {
  534.     global exit_status
  535.     send_error "\nterminated\n"
  536.     log_summary
  537.     close_logs
  538.     cleanup
  539.     exit $exit_status
  540. } SIGTERM
  541. trap {
  542.     global exit_status
  543.     send_error "\ninterrupted by user\n"
  544.     log_summary
  545.     close_logs
  546.     cleanup
  547.     exit $exit_status
  548. } SIGINT
  549. trap {
  550.     global exit_status
  551.     send_error "\nsegmentation violation\n"
  552.     log_summary
  553.     close_logs
  554.     cleanup
  555.     exit $exit_status
  556. } SIGSEGV
  557. trap {
  558.     global exit_status
  559.     send_error "\nsigquit\n"
  560.     log_summary
  561.     close_logs
  562.     cleanup
  563.     exit $exit_status
  564. } SIGQUIT
  565.  
  566. #
  567. # main test execution loop
  568. #
  569. reset_vars
  570. foreach dir [lsort [getdirs $srcdir $tool*]] {
  571.     foreach test_name [lsort [find $dir *.exp]] {
  572.     set subdir [file dirname [string range ${test_name} [expr [string length $srcdir]+1] end]]
  573.     if [string match "" ${test_name}] then {
  574.         continue
  575.     }
  576.     # check to see if the range of tests is limited 
  577.     if ![string match "" $runtests] then {
  578.         if ![expr 0<=[lsearch $runtests [file tail ${test_name}]]] then {
  579.         continue
  580.         }
  581.     }
  582.     if ![string match "" $ignoretests] then {
  583.         if [expr 0<=[lsearch $ignoretests [file tail ${test_name}]]] then {
  584.         continue
  585.         }
  586.     }
  587.     clone_output "Running ${test_name} ..."
  588.     set prms_id    0
  589.     set bug_id    0
  590.     set test_result ""
  591.     if [file exists $test_name] then {
  592.         catch "source ${test_name}" test_result
  593.         if ![string match "" $test_result] then {
  594.                 if ![string match "0" $test_result] then {
  595.                     error "Got an error from ${test_name}\n$test_result"
  596.                     set test_result ""
  597.                     continue
  598.                 }
  599.         }
  600.     } else {
  601.         error "$test_name does not exist."
  602.     }
  603.     }    
  604. }
  605.  
  606. #
  607. # all done, cleanup
  608. #
  609. if {[info procs ${tool}_exit] != ""} then {
  610.     ${tool}_exit
  611. }
  612.  
  613. log_summary
  614. close_logs
  615. if $do_a_diff then {
  616.    if [diff_logs $psum_file] then {
  617.       if $mail_logs then {
  618.          mail_file $outdir/$tool.diff $mailing_list "Dejagnu Summary Diff"
  619.       }
  620.    } else {
  621.       if $mail_logs then {
  622.          catch "exec mail -s \"Dejagnu - No Differences Found\" $mailing_list < /dev/null"
  623.       }
  624.    }
  625. } else {
  626.    if $mail_logs then {
  627.       mail_file $outdir/$tool.sum $mailing_list "Dejagnu Summary Log"
  628.    }
  629. }
  630. cleanup
  631. exit $exit_status
  632.